home *** CD-ROM | disk | FTP | other *** search
/ Win 50 Game+ Vol. 7 (Japan) / Win 50 Game+ Vol. 7 (Japan).7z / Win 50 Game+ Vol. 7 (Japan).bin / lha_file / sheep11_.lzh / SH11SRC.LZH / MGMAIN.PAS < prev    next >
Pascal/Delphi Source File  |  1996-05-30  |  7KB  |  254 lines
  1. unit Mgmain;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, ExtCtrls, Menus, about;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     MainMenu1: TMainMenu;
  12.     Game1: TMenuItem;
  13.     New1: TMenuItem;
  14.     N1: TMenuItem;
  15.     Exit1: TMenuItem;
  16.     Options1: TMenuItem;
  17.     Speed1: TMenuItem;
  18.     Slow1: TMenuItem;
  19.     Mid1: TMenuItem;
  20.     Fast1: TMenuItem;
  21.     Veryfast1: TMenuItem;
  22.     Sheep1: TMenuItem;
  23.     N20sheep1: TMenuItem;
  24.     N30sheep1: TMenuItem;
  25.     N50sheep1: TMenuItem;
  26.     N100sheep1: TMenuItem;
  27.     Timer2: TMenuItem;
  28.     N60sec1: TMenuItem;
  29.     N120sec1: TMenuItem;
  30.     N180sec1: TMenuItem;
  31.     N300sec1: TMenuItem;
  32.     Help1: TMenuItem;
  33.     Index1: TMenuItem;
  34.     About1: TMenuItem;
  35.     Score1: TMenuItem;
  36.     Timer1: TTimer;
  37.     procedure FormCreate(Sender: TObject);
  38.     procedure New1Click(Sender: TObject);
  39.     procedure Exit1Click(Sender: TObject);
  40.     procedure speedClick(Sender: TObject);
  41.     procedure sheepClick(Sender: TObject);
  42.     procedure timeClick(Sender: TObject);
  43.     procedure Index1Click(Sender: TObject);
  44.     procedure About1Click(Sender: TObject);
  45.     procedure Timer1Timer(Sender: TObject);
  46.     procedure FormResize(Sender: TObject);
  47.     procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  48.       Y: Integer);
  49.   private
  50.     { Private ÉΘî╛ }
  51.   public
  52.     { Public ÉΘî╛ }
  53.   end;
  54.  
  55. var
  56.   Form1: TForm1;
  57.  
  58. implementation
  59.  
  60. {$R *.DFM}
  61.  
  62. const bmax = 100;
  63.       showt = 19 * 21;
  64.       minsize = 200;
  65.       backc = clgreen;
  66.       ballc1 = clwhite;
  67.       ballc2 = clyellow;
  68.       specialc = clred;
  69.  
  70. type Tball = record
  71.                 x, y, xx, yy, abxx, abyy : real;
  72.                 ix, iy : integer;
  73.                 shape : Trect;
  74.              end;
  75.  
  76. var    ball : array[1..bmax] of Tball;
  77.     fullrect : Trect;
  78.     balls : byte;
  79.     l, counter, time, mx, my, scx, scy, cx, cy, rate : integer;
  80.     score, best, max, sp, r1, r2 : real;
  81.  
  82. procedure TForm1.FormCreate(Sender: TObject);
  83. var i, j : integer;
  84. begin
  85.     randomize;
  86.     balls := 30;
  87.     rate := 5;
  88.     time := 2299;
  89.     max := 78.0;
  90.     formresize(sender);
  91.     new1click(sender);
  92. end;
  93.  
  94. procedure TForm1.New1Click(Sender: TObject);
  95. var i : integer;
  96. begin
  97.     best := 0;
  98.     counter := time;
  99.     for i := 1 to bmax do with ball[i] do begin
  100.         x := random(scx-40)+20;
  101.         y := random(scy-40)+20;
  102.         ix := round(x);
  103.         iy := round(y);
  104.         xx := (random * 2 - 1) * sp;
  105.         yy := (random * 2 - 1) * sp;
  106.         abxx := abs(xx);
  107.         abyy := abs(yy);
  108.     end;
  109.     canvas.brush.color := backc;
  110.     canvas.fillrect(fullrect);
  111. end;
  112.  
  113. procedure TForm1.Exit1Click(Sender: TObject);
  114. begin
  115.     application.terminate;
  116. end;
  117.  
  118. procedure TForm1.speedClick(Sender: TObject);
  119. begin
  120.     slow1.checked := false;
  121.      mid1.checked := false;
  122.     fast1.checked := false;
  123.     veryfast1.checked := false;
  124.     (sender as Tmenuitem).checked := true;
  125.     rate := (sender as Tmenuitem).tag;
  126.     sp := (scx + scy) * rate / 8000;
  127. end;
  128.  
  129. procedure TForm1.sheepClick(Sender: TObject);
  130. begin
  131.      N20sheep1.checked := false;
  132.      N30sheep1.checked := false;
  133.      N50sheep1.checked := false;
  134.     N100sheep1.checked := false;
  135.     (sender as Tmenuitem).checked := true;
  136.     balls := (sender as Tmenuitem).tag;
  137.     max := 2.0 * balls + 18;
  138.     new1click(sender);
  139. end;
  140.  
  141. procedure TForm1.timeClick(Sender: TObject);
  142. begin
  143.      N60sec1.checked := false;
  144.     N120sec1.checked := false;
  145.     N180sec1.checked := false;
  146.     N300sec1.checked := false;
  147.     (sender as Tmenuitem).checked := true;
  148.     time := (sender as Tmenuitem).tag;
  149.     new1click(sender);
  150. end;
  151.  
  152. procedure TForm1.Index1Click(Sender: TObject);
  153. begin
  154.     application.HelpJump('HID_N0001');
  155. end;
  156.  
  157. procedure TForm1.About1Click(Sender: TObject);
  158. begin
  159.     aboutbox.showmodal;
  160. end;
  161.  
  162. procedure TForm1.Timer1Timer(Sender: TObject);
  163. begin
  164.     for l := 1 to balls do with ball[l] do begin
  165.         x := x + xx;
  166.         y := y + yy;
  167.         ix := round(x);
  168.         iy := round(y);
  169.         r1 := 110 * sp / ((x-mx)*(x-mx)+(y-my)*(y-my)+0.1);
  170.         r2 := abs(x-mx) + abs(y-my);
  171.         xx := xx + r1 * (x-mx) / r2;
  172.         yy := yy + r1 * (y-my) / r2;
  173.         abxx := abs(xx);
  174.         abyy := abs(yy);
  175.         if abxx > sp then xx := xx / abxx * sp;
  176.         if abyy > sp then yy := yy / abyy * sp;
  177.         if ix < 20 then xx := abxx else if ix > scx-24 then xx := -abxx;
  178.         if iy < 20 then yy := abyy else if iy > scy-24 then yy := -abyy;
  179.     end;
  180.     with ball[1] do begin
  181.         canvas.brush.color := backc;
  182.         canvas.fillrect(shape);
  183.         shape := rect(ix,iy,ix+4,iy+4);
  184.         if counter >= showt then canvas.brush.color := ballc1
  185.                             else canvas.brush.color := specialc;
  186.         canvas.fillrect(shape);
  187.         score := (abs(ix/cx-1) + abs(iy/cy-1)) * 10;
  188.     end;
  189.     for l := 2 to balls do with ball[l] do begin
  190.         canvas.brush.color := backc;
  191.         canvas.fillrect(shape);
  192.         shape := rect(ix,iy,ix+4,iy+4);
  193.         if odd(l) then canvas.brush.color := ballc1
  194.                   else canvas.brush.color := ballc2;
  195.         canvas.fillrect(shape);
  196.         score := score + abs(ix/cx-1) + abs(iy/cy-1);
  197.     end;
  198.     score := 100 - score  / max * 200;
  199.     if best < score then best := score;
  200.     dec(counter);
  201.     score1.caption := inttostr(round(score)) + '/' + inttostr(round(best))
  202.                         + ' T:' + inttostr(counter div 19);
  203.     if counter = 0 then begin
  204.         timer1.enabled := false;
  205.         aboutbox.comment.caption := 'Your score is ' + inttostr(round(best));
  206.         aboutbox.showmodal;
  207.         aboutbox.comment.caption := '';
  208.         new1click(sender);
  209.         timer1.enabled := true;
  210.     end;
  211. end;
  212.  
  213. procedure TForm1.FormResize(Sender: TObject);
  214. var i : integer;
  215. begin
  216.     if clientwidth < minsize then clientwidth := minsize;
  217.     if clientheight < minsize then clientheight := minsize;
  218.     if scx > 0 then r1 := clientwidth / scx;
  219.     if scy > 0 then r2 := clientheight / scy;
  220.        scx := clientwidth;
  221.     scy := clientheight;
  222.        cx := scx div 2 - 1;
  223.     cy := scy div 2 - 1;
  224.        canvas.brush.color := backc;
  225.     fullrect := rect(0,0,scx,scy);
  226.        canvas.fillrect(fullrect);
  227.     for i := 1 to balls do with ball[i] do begin
  228.            x := x * r1;
  229.            y := y * r2;
  230.         if x < 20 then x := 20 else if x > scx-24 then x := scx - 24;
  231.         if y < 20 then y := 20 else if y > scy-24 then y := scy - 24;
  232.            ix := round(x);
  233.         iy := round(y);
  234.            xx := xx * r1;
  235.         yy := yy * r2;
  236.            abxx := abxx * r1;
  237.         abyy := abyy * r2;
  238.            if odd(l) then canvas.brush.color := ballc1
  239.                   else canvas.brush.color := ballc2;
  240.         shape := rect(ix,iy,ix+4,iy+4);
  241.            canvas.fillrect(shape);
  242.     end;
  243.     sp := (scx + scy) * rate / 8000;
  244. end;
  245.  
  246. procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  247.   Y: Integer);
  248. begin
  249.     mx := x;
  250.     my := y;
  251. end;
  252.  
  253. end.
  254.